home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / examples / demo / demosrc / d_map.pro < prev    next >
Encoding:
Text File  |  1997-07-08  |  33.7 KB  |  998 lines
  1. ; $Id: d_map.pro,v 1.25 1997/04/24 23:32:25 dave Exp $
  2. ;
  3. ;  Copyright (c) 1997, Research Systems, Inc. All rights reserved.
  4. ;       Unauthorized reproduction prohibited.
  5. ;
  6. ;+
  7. ;  FILE:
  8. ;       d_map.pro
  9. ;
  10. ;  CALLING SEQUENCE: d_map
  11. ;
  12. ;  PURPOSE:
  13. ;       Shows  the mapping features in IDL 5.0.
  14. ;
  15. ;  MAJOR TOPICS: Visualization and maps
  16. ;
  17. ;  CATEGORY:
  18. ;       IDL 5.0
  19. ;
  20. ;  INTERNAL FUNCTIONS and PROCEDURES:
  21. ;       fun MenuToggleState     -  Toggle off and on state of a button
  22. ;       fun Map_Menu_Choice     -  Handle the menu bar selection button
  23. ;       pro MenuCreate          -  Create the menu bar
  24. ;       pro Map_Demo_Color      -  Initialize working colors
  25. ;       pro drawcirc            -  Draw a great circle
  26. ;       pro cir2p               -  Connect 2 points with a great circle
  27. ;       fun city_mark           -  Mark a city
  28. ;       pro d_map_Event      -  Event handler
  29. ;       pro d_map_Cleanup    -  Cleanup
  30. ;       pro d_map            -  Main procedure
  31. ;
  32. ;  EXTERNAL FUNCTIONS, PROCEDURES, and FILES:
  33. ;       pro gettips             -  Read the tip file
  34. ;       pro widtips             -  Create the tip widgets
  35. ;       pro sizetips            -  Size the tip widgets
  36. ;       pro puttips             -  Change a tips text
  37. ;       map_demo.txt
  38. ;       map_demo.tip
  39. ;       cities.dat
  40. ;       worldelv.dat
  41. ;
  42. ;  REFERENCE: IDL Reference Guide, IDL User's Guide
  43. ;
  44. ;  NAMED STRUCTURES:
  45. ;       none.
  46. ;
  47. ;  COMMON BLOCKS:
  48. ;       MAP_DEMO_COM
  49. ;
  50. ;  MODIFICATION HISTORY:
  51. ;       3/97,   DMS   - Written.
  52. ;-
  53. ;----------------------------------------------------------------------------
  54. ;
  55. ;    PURPOSE  Toggle the off and on state of a menu button
  56. ;
  57. Function MenuToggleState, $
  58.                           wid   ;  IN: widget identifier
  59.  
  60. WIDGET_CONTROL, wid, GET_VALUE=name
  61.  
  62. s = STRPOS(name, '(Off)')
  63. ret = s ne -1                   ;TRUE if new state is on
  64. if ret then strput, name, '(On )', s $
  65. else strput, name, '(Off)', strpos(name, '(On )')
  66. WIDGET_CONTROL, wid, SET_VALUE=name
  67. RETURN, ret
  68. end                             ;   of  Toggle_state,
  69.  
  70. ;----------------------------------------------------------------------------
  71. ;
  72. ;    PURPOSE   Given a uservalue from a menu button created 
  73. ;              by MenuCreate, return the index of the choice
  74. ;              within the category.  Set the selected menu button
  75. ;              to insensitive to signify selection, and set all
  76. ;              other choices for the category to sensitive.
  77. ;
  78. function Map_menu_choice, $
  79.             Eventval, $         ; IN: uservalue from seleted menu button
  80.             MenuItems, $        ; IN: menu item array, as returned by MenuCreate
  81.             MenuButtons         ; IN: button array as returned by MenuCreate
  82.  
  83.  
  84. i = STRPOS(eventval, '|', 0)    ;Get the name less the last qualifier
  85. while (i GE 0) do begin
  86.     j = i 
  87.     i = STRPOS(eventval, '|', i+1)
  88. endwhile
  89.  
  90. base = STRMID(eventval, 0, j+1) ;  Get the common buttons, includes last | .
  91. buttons = WHERE(STRPOS(MenuItems, base) EQ 0) ;  buttons that share base name.
  92. this = (WHERE(eventval EQ MenuItems))(0) ;  Get the Index of the selected item.
  93. for i=0, N_ELEMENTS(buttons)-1 do begin ;Each button in this category
  94.     index = buttons(i)
  95.     WIDGET_CONTROL, MenuButtons(buttons(i)), $
  96.       SENSITIVE=index NE this
  97. endfor
  98.  
  99. RETURN, this - buttons(0)       ;  Return the selected button's index.
  100. end
  101.  
  102. ;----------------------------------------------------------------------------
  103. ;
  104. ;    PURPOSE  Create a menu from a string descriptor (MenuItems).
  105. ;             Return the parsed menu items in MenuItems (overwritten),
  106. ;             and the array of corresponding menu buttons in MenuButtons.
  107. ;
  108. ;    MenuItems = (input/output), on input the menu structure
  109. ;                in the form of a string array.  Each button
  110. ;                is an element, encoded as follows:
  111. ;
  112. ;    Character 1 = integer bit flag.  Bit 0 = 1 to denote a
  113. ;                  button with children.  Bit 1 = 2 to denote
  114. ;                  this is the last child of its parent.
  115. ;                  Bit 2 = 4 to show that this button should 
  116. ;                  initially be insensitive, to denote selection.
  117. ;                  Any combination of bits may be set.
  118. ;               On RETURN, MenuItems contains the fully
  119. ;                  qualified button names.
  120. ;
  121. ;    Characters 2-end = Menu button text.  Text should NOT
  122. ;                       contain the character |, which is used
  123. ;                       to delimit menu names.
  124. ;
  125. ;    Example:
  126. ;
  127. ;        MenuItems = ['1File', '0Save', '2Quit', $
  128. ;        '1Edit', '3Cut', $
  129. ;        '3Help']
  130. ;
  131. ;         Creates a menu with three top level buttons
  132. ;         (file, edit and help). File has 2 choices
  133. ;         (save and exit), Edit has one choice, and help has none.
  134. ;         On RETURN, MenuItems contains the fully qualified
  135. ;         menu button names in a string array of the
  136. ;         form: ['<Prefix>|File', '<Prefix>|File|Save', 
  137. ;            '<Prefix>|File|Quit', '<Prefix>|Edit',..., etc. ]
  138. ;
  139. pro MenuCreate, $
  140.                 MenuItems, $    ; IN/OUT: See below
  141.                 MenuButtons, $  ; OUT: Button widget id's of the created menu
  142.                 Bar_base, $     ; IN: menu base ID
  143.                 Prefix=prefix   ; IN: (opt) Prefix for this menu's button names.
  144.                                 ;     If omitted, no prefix
  145.  
  146. level = 0
  147. parent = [ bar_base, 0, 0, 0, 0, 0]
  148. names = STRARR(5)
  149. lflags = INTARR(5)
  150.  
  151. MenuButtons = LONARR(N_ELEMENTS(MenuItems))
  152.  
  153. if (N_ELEMENTS(prefix)) then begin
  154.     names(0) = prefix + '|' 
  155. endif else begin
  156.     names(0) = '|'
  157. endelse
  158.  
  159. for i=0, N_ELEMENTS(MenuItems)-1 do begin
  160.     flag = FIX(STRMID(MenuItems(i), 0, 1))
  161.     txt = STRMID(MenuItems(i), 1, 100)
  162.     uv = ''
  163.     
  164.     for j = 0, level do uv = uv + names(j)
  165.     MenuItems(i) = uv + txt     ;  Create the button for fully qualifid names.
  166.     isHelp = txt eq 'Help' or txt eq 'About'
  167.     MenuButtons(i) = WIDGET_BUTTON(parent(level), $
  168.                                    VALUE= txt, UVALUE=uv+txt, $
  169.                                    MENU=flag and 1, HELP=isHelp)
  170.     
  171.     if ((flag AND 4) NE 0) then begin
  172.         WIDGET_CONTROL, MenuButtons(i), SENSITIVE = 0
  173.     endif
  174.     
  175.     if (flag AND 1) then begin
  176.         level = level + 1
  177.         parent(level) = MenuButtons(i)
  178.         names(level) = txt + '|'
  179.         lflags(level) = (flag and 2) NE 0
  180.     endif else if ((flag AND 2) NE 0) then begin
  181.         while lflags(level) do level = level-1 ;  Pops the previous levels.
  182.         level = level - 1     
  183.     endif
  184. endfor
  185. end
  186.  
  187. ;----------------------------------------------------------------------------
  188. ;
  189. ;    PURPOSE  Initialize the working colors.
  190. ;
  191. pro map_demo_color, base
  192.  
  193. common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
  194.  
  195.  
  196. nc = !d.table_size < 256 > 16   ;# of colors we use
  197.  
  198. if (N_ELEMENTS(r_orig) NE nc) then begin
  199.     r_orig = BYTARR(nc)
  200.     g_orig = BYTARR(nc)
  201.     b_orig = BYTARR(nc)
  202. endif
  203.  
  204.     ;  Define interpolation points:
  205.     ;  (elevation in meters, r, g, b)  be sure elevation of 1st element is
  206.     ;  -5000 (data value 0), and last is 5240 (data value 256).
  207.     ;  With this scaling, sea level is ~ 125.
  208.  
  209. c = FLTARR(256, 3)
  210.  
  211. nelev = nc - base               ;# of color for elevations
  212.  
  213. ;      Elev   Red Green Blue
  214. p = [[ -5000,  64,  64,  64], $ ; Dark Gray at 0
  215.      [ -4900,   0,   0, 128], $ ; Dim blue
  216.      [ -1500,   0,   0, 255], $ ; Bright blue
  217.      [   -40, 192, 192, 255], $ ; Brownish
  218.      [     0,  64, 192,  64], $ ; Med green
  219.      [   250, 150, 150,  75], $ ; Dim Yellow
  220.      [  1000, 200, 200, 100], $ ; Brighter yellow
  221.      [  4000, 255, 255, 255], $ ; White
  222.      [  5240, 255, 255, 255]]   ; To white
  223.  
  224. n = N_ELEMENTS(p)/4
  225.  
  226. for i=0,n-2 do begin            ;Each interpolation interval
  227.     s0 = (p(0,i)+5000) * nelev / (256 * 40)
  228.     s1 = (p(0,i+1)+5000) * nelev / (256 * 40)
  229.     m = s1 - s0
  230.     if m gt 0 then for j=0,2 do begin ;  Loop over each color.
  231.         s = FLOAT(p(j+1,i+1) - p(j+1,i)) / m
  232.         c(s0, j) = FINDGEN(m) * s + p(j+1,i)
  233.     endfor
  234. endfor
  235.  
  236. TEK_COLOR, 0, base              ;Load original tektronix color table.
  237. r_orig(base) = BYTE(c(0:nelev-1,0))
  238. g_orig(base) = BYTE(c(0:nelev-1,1))
  239. b_orig(base) = BYTE(c(0:nelev-1,2))
  240. r_curr = r_orig
  241. g_curr = g_orig
  242. b_curr = b_orig
  243. TVLCT,r_orig, g_orig, b_orig
  244. end
  245.  
  246. ;----------------------------------------------------------------------------
  247. ;
  248. ;    PURPOSE Draw a great circle with given rotation and offset.
  249. ;
  250. pro drawcirc, $
  251.               rot, $            ; IN: rotation angle (in degrees)
  252.               lon0, $           ; IN: longitude 
  253.               color             ; IN: color of the great circle
  254.  
  255. n = 180                         ;Use 180 points
  256. rota = rot * !DTOR        ;Radians
  257.  
  258. t = FINDGEN(n+1) * (2 * !PI/n)
  259. sint = SIN(t)
  260. y = COS(t)
  261. x = sint * SIN(rota)
  262. z = sint * COS(rota)
  263. lat = ASIN(z) * !RADEG
  264. lon = ATAN(x,y) * !RADEG + lon0
  265. lon = lon + (lon LT -180.) * 360.
  266. lon = lon - (lon GT 180.) * 360.
  267. PLOTS, lon, lat, COLOR=color, THICK=2
  268. end
  269.  
  270. ;----------------------------------------------------------------------------
  271. ;
  272. ;    PURPOSE   Connect two points, in the form of [lon, lat] with
  273. ;              a great circle.
  274. ;
  275. pro cir_2p, $
  276.        p1, $                    ; IN: first point
  277.        p2                       ; IN: second point
  278.  
  279. COMMON map_demo_com, projs, iproj, map_window, $
  280.   lat0, lon0, rot0, do_elev, do_cont, cir , drawable, lat_slider, $
  281.   lon_slider, sat_params, sat_base, rot_slider, $
  282.   city_pos, elev_data, last_p, iso, $
  283.   all_cities, scale, interpolation, do_rivers, $
  284.   do_political, MenuButtons, MenuItems, ElevColor, $
  285.   sText, wText, city_base, scale_txt, groupBase, SavedColors, MousePress
  286.  
  287.  
  288. r_earth = 6371.007              ; Constants: Mean radius of earth, KM
  289. km_mile = 0.621                 ; Km per mile
  290.  
  291. p1r = p1 * !dtor                ;To radians
  292. p2r = p2 * !dtor
  293.  
  294. twopi = 2 * !pi
  295. dlon = twopi + p2r(0) - p1r(0)
  296. while (dlon GT !pi) do dlon = dlon - twopi ;to -pi to +pi
  297.  
  298. ;          Compute the Great Circle Distance (in KM).
  299. cosd = SIN(p1r(1))*SIN(p2r(1)) + COS(p1r(1))*COS(p2r(1))*COS(dlon)
  300. dst = r_earth * ACOS(cosd)    
  301.  
  302. ;  Transform the spherical coordinates (long.  lat.) to cartesian (x, y, z).
  303. lon = [p1r(0), p2r(0)]
  304. lat = [p1r(1), p2r(1)]
  305. x = COS(lat) * SIN(lon)
  306. y = COS(lat)* COS(lon)
  307. z = SIN(lat)
  308.  
  309. ;  Compute the Plane containing center of earth and the points.
  310. a = z(0) * y(1) - y(0) * z(1)    
  311. b = z(1) * x(0) - x(1) * z(0)    ; aX + bY = Z
  312.  
  313. elon0 = -ATAN(b/a)              ;  Compute the equatorial crossing location.
  314. rot = ATAN(tan(lat(1)) / SIN(lon(1) - elon0))
  315. rot = 90 - rot * !radeg
  316.  
  317. cir.lon0 = !RADEG * elon0
  318. cir.rot = rot
  319.  
  320. str1 = STRING(dst, dst*km_mile, $
  321.               FORMAT="('Distance: ',i5,'km, ', i5, 'mi')")
  322. str2 = STRING(cir.rot, cir.lon0, $
  323.               FORMAT="('Incl.: ',f6.1, ', Eq. cross.: ',F5.1)")
  324. sText.text[9] = str1
  325. sText.text[10] = str2
  326. putTips, sText, wText[1], ['dist1', 'dist2'], [0,1]
  327.  
  328. cir.color = cir.color+1
  329.  
  330. if (cir.color GE 10) then cir.color = 4 ;use color indices 4 to 9 for gt circl
  331. drawcirc, cir.rot, cir.lon0, cir.color ;  Draw the great circle 
  332. PLOTS, p1(0), p1(1), psym=5    ; and mark the points.
  333. PLOTS, p2(0), p2(1), psym=5
  334.  
  335. end
  336.  
  337. ;----------------------------------------------------------------------------
  338. ;
  339. ;    PURPOSE Mark the Ith city and return [lon, lat]
  340. ;
  341. function city_mark, $
  342.              i, $               ; IN: City index
  343.              COLOR=color        ; IN: Color index
  344.  
  345. COMMON map_demo_com
  346.  
  347. lon = city_pos.pos(1,i)
  348. lat = city_pos.pos(0,i)
  349.  
  350. p = CONVERT_COORD(lon, lat, /DATA, /TO_DEVICE)
  351.  
  352. if (FINITE(p(0)) EQ 0) then RETURN, p
  353.  
  354. PLOTS, p(0), p(1), /DEVICE, PSYM=4, NOCLIP=0
  355.  
  356. if (N_ELEMENTS(color) EQ 0) then COLOR=1
  357.  
  358. XYOUTS, p(0), p(1)- 3*!D.Y_CH_SIZE/4, $
  359.   /DEVICE, city_pos.names(i), $
  360.   NOCLIP=0, ALIGNMENT=0.5, COLOR=color
  361.  
  362. RETURN, [lon, lat]
  363. end
  364.  
  365. ;----------------------------------------------------------------------------
  366. ;
  367. ;    PURPOSE  Draw the map
  368. ;
  369. pro map_demo_draw
  370.  
  371. COMMON map_demo_com
  372.  
  373. WSET, map_window
  374.  
  375. lat1 = lat0                     ;  Take care of special cases:
  376. scale1 = scale
  377.  
  378. if (STRPOS(projs(iproj), "Conic") GE 0) then begin
  379.     if (scale1 EQ 0) then scale1 = 50e6 ;  force default scaling.
  380.     scale1 = scale1 < 100e6
  381.     lat1 = lat1 < 60 > (-60)    ;  Stay away from the poles.
  382.     minlat = 20
  383.     if (ABS(lat1) LT minlat) then lat1 = ([minlat, -minlat])(lat1 LT 0)
  384.     if (rot0 NE 0) then begin   ; Force 0 rotation for conics
  385.         rot0 = 0.0
  386.         WIDGET_CONTROL, rot_slider, SET_VALUE=0.0
  387.     endif
  388. endif
  389.  
  390. if (projs(iproj) EQ 'TransverseMercator') then begin
  391.     if (scale1 EQ 0) then scale1 = 50e6 ;  Set default scaling.
  392.     scale1 = scale1 < 100e6     ;maximum scale
  393.     lat1 = lat1 > (-50) < 50    ;  Stay away from poles.
  394. endif
  395.  
  396. if (lat1 NE lat0) then $        ;Update slider if we fudged things
  397.     WIDGET_CONTROL, lat_slider, SET_VALUE=lat1
  398.  
  399. lat0 = lat1
  400.  
  401. t0 = systime(1)                 ;  Get the starting time.
  402.  
  403. map_set, lat1, lon0, rot0, $    ;Draw basic projection
  404.   PROJ = iproj, GRID=0, COLOR=1, $
  405.   sat_p = sat_params, $
  406.   ISOTROPIC=iso, scale=scale1
  407.  
  408.                                 ; print, !map.ll_box, format='(4f10.2)'
  409.  
  410. wWarningBase = 0
  411.  
  412. ; Load elevations ****
  413. if ( (do_elev NE 0) AND (N_ELEMENTS(elev_data) LE 2) ) then begin ;  1st time?
  414.     wWarningBase = WIDGET_BASE(TITLE='Warning', /COLUMN)
  415.     wWarning1Label = WIDGET_LABEL(wWarningBase, $
  416.                                   VALUE='Warping elevation data to maps can')
  417.     wWarning2Label = WIDGET_LABEL(wWarningBase, $
  418.                                   VALUE='require a significant amount of time.')
  419.  
  420.     WIDGET_CONTROL, wWarningBase, /REALIZE
  421.  
  422.     file = filepath('worldelv.dat', $
  423.                     SUBDIR=['examples','data'])
  424.  
  425.     OPENR,unit, /GET_LUN, file, ERROR=i
  426.  
  427.     if (i LT 0) then begin
  428.         a = DIALOG_MESSAGE(['Elevation data file', $
  429.                             file, 'not found'], /ERROR)
  430.         do_elev = 0             ;Still have no elevations
  431.     endif else begin            ;we've found the file
  432.         elev_data = BYTARR(360, 360, /NOZERO)
  433.         READU, unit, elev_data
  434.         CLOSE, unit
  435.         FREE_LUN, unit
  436.         elev_data = bytscl(elev_data, TOP=!d.table_size - ElevColor - 1, $
  437.                            MAX=255, MIN=0) + $
  438.           byte(ElevColor) > byte(ElevColor + 1b)
  439.     endelse
  440. endif                           ;  of load elevation data
  441.  
  442. t1 = systime(1)
  443.  
  444. ;  Draw the elevation data.
  445.  
  446. if ((do_elev NE 0) AND (N_ELEMENTS(elev_data) GT 2)) then begin
  447.     nlon = ([0,180, 360, 360])(do_elev) ;Low, Medium and High resolutions
  448.     nlat = ([0, 90, 180, 180])(do_elev)
  449.  
  450.     lat_del = 180 / nlat
  451.     lon_del = 360 / nlon
  452.     lat_0 = -90. & lat1 = 90. - lat_del
  453.     lon_0 = 0. & lon_1 = 360. - lon_del
  454.     tmp = REBIN(elev_data, nlon, nlat,/SAMPLE)
  455.  
  456.     if (!map.ll_box(0) NE !map.ll_box(2)) then begin ;  Clip the latitude.
  457.         i0 = floor((!map.ll_box(0)+90) / lat_del) ;First bin
  458.         i1 = ceil((!map.ll_box(2)+90) / lat_del)  < (nlat -1) ;Last bin
  459.         tmp = tmp(*, i0:i1 )
  460.         lat_0 = lat_del * i0 -90.
  461.         lat1 = lat_del * i1 -90.
  462.     endif
  463.  
  464.     if (!map.ll_box(1) NE !map.ll_box(3)) then begin ;  Clip the longitude.
  465.         i0 = floor(!map.ll_box(1) / lon_del) ;First bin
  466.         i1 = ceil( !map.ll_box(3) / lon_del) ;Last bin
  467.         j0 = i0
  468.         if (j0 LT 0) then j0 = j0 + nlon
  469.         if (j0 NE 0) then tmp = shift(tmp, -j0, 0)
  470.         n = i1 - i0 + 1
  471.         if (n LT nlon) then tmp = tmp(0:n-1, *)
  472.         lon_0 = i0 * lon_del
  473.         lon_1 = i1 * lon_del
  474.     endif
  475.  
  476.     if (interpolation) then begin
  477.         TV, MAP_PATCH(tmp, LON0=lon_0, LON1=lon_1, $ ;Object interpolation
  478.                       LAT0=lat_0, LAT1=lat1, $
  479.                       XSTART=x0, YSTART=y0), x0, y0
  480.     endif else begin
  481.         TV, MAP_IMAGE(tmp, $    ;Image interpolation
  482.                       LONMIN=lon_0, LONMAX=lon_1, LATMIN=lat_0, LATMAX=lat1, $
  483.                       /BILINEAR, COMPRESS= ([0,4, 4,2,1])(do_elev), x0, y0), $
  484.           x0, y0
  485.     endelse
  486. endif                           ;   of  Do_elev
  487.  
  488. if (wWarningBase NE 0) then WIDGET_CONTROL, wWarningBase, /DESTROY
  489.  
  490. t1 = systime(1) - t1            ;  Get the executon time.
  491.  
  492. if (do_elev NE 0) then $        ;  Don't do both continents and elevation.
  493.   i = do_cont < 1 $
  494. else i = do_cont
  495.  
  496. map_horizon, COLOR=([1,1,4])(i), FILL=i EQ 2 ; Blue horizon
  497.  
  498. if (i EQ 1) then map_continents, COLOR=1 ;Line continents
  499. if (i EQ 2) then map_continents, COLOR=5, /fill ;Filled continents
  500.  
  501. map_grid, latdel = 10, londel = 10, COLOR=3
  502.  
  503. if (do_rivers) then map_continents, /RIVER, COLOR=4
  504. if (do_political) then map_continents, /COUNTRIES, /USA, COLOR=1
  505. if ((do_cont GE 2) OR (do_elev NE 0)) then CCOLOR=0 else CCOLOR=1
  506. if (all_cities) then for i=0, N_ELEMENTS(city_pos.names)-1 do $
  507.   p = city_mark(i, COLOR=ccolor)
  508.  
  509. if (do_elev NE 0) then  begin   ;Execution time
  510.     t = t1 + systime(1)-t0
  511. endif else begin
  512.     t = systime(1)-t0
  513. endelse
  514.  
  515. estr='Time =' + STRING(t, FORMAT='(F6.1)')+ ' seconds' ;Display exec time
  516. sText.text[7] = estr
  517.  
  518. putTips, sText, wText[1], ['selecto','time1'], [0,1]
  519. end
  520.  
  521. ;----------------------------------------------------------------------------
  522. ;
  523. ;  PURPOSE Main event handler.
  524. ;
  525. pro d_map_event,  $
  526.        event                    ; IN: event structure
  527.  
  528. COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
  529. COMMON map_demo_com
  530.  
  531.  
  532. if (TAG_NAMES(event, /STRUCTURE_NAME) EQ $ ;Was application closed?
  533.     'WIDGET_KILL_REQUEST') then begin
  534.     WIDGET_CONTROL, event.top, /DESTROY
  535.     RETURN
  536. endif
  537.  
  538. WIDGET_CONTROL, event.id, GET_UVALUE=eventval
  539. s = SIZE(eventval)
  540. WSET, map_window
  541.  
  542. if (event.id EQ drawable) then begin ;Mouse event in drawable
  543.                                 ;  Get inverse transform (lat, lon):
  544.     p = CONVERT_COORD(event.x, event.y, /DEVICE, /TO_DATA)
  545.     
  546.     if (FINITE(p(0)) EQ 0) then begin ;IDL 5.0 returns NaN for unmappable pnts
  547.         off_map:  
  548.         sText.text[6] = '<Off map>'
  549.         putTips, sText, wText[1], ['locat'], [2]
  550.         RETURN
  551.     endif
  552.     
  553.     if (event.press NE 0) then begin ;  Save location of button press events
  554.         MousePress = [event.x, event.y]
  555.         goto, set_ll
  556.     endif
  557.     
  558.     if (event.release EQ 0) then begin ;If release is 0, its a motion event
  559.         sText.text[6] = STRING(p(0), p(1), $
  560.                                FORMAT= "('Lon: ',f7.1, ', Lat: ', f6.1)")
  561.         putTips, sText, wText[1], ['locat'], [2]        
  562.         RETURN
  563.     endif
  564.  
  565. ; If we get here, its a drag event. Put a hysteresis on the drag so that
  566. ;  it's not mistaken for a smudged click.
  567.     if (ABS(event.x-MousePress[0]) + $
  568.         ABS(event.y NE MousePress[1]) GE 4) then begin
  569.         q = CONVERT_COORD(MousePress, /DEVICE, /TO_DATA)
  570.         if (FINITE(q(0)) EQ 0) then return
  571.         lat0 = lat0 + (q(1)-p(1)) ;Get new center of projection
  572.         if (lat0 GT 180.) then lat0 = lat0 - 360.
  573.         if (lat0 LT -180.) then lat0 = lat0 + 360.
  574.         if (lat0 GT 90.) then lat0 = 180.-lat0
  575.         if (lat0 LT -90.) then lat0 = -180.-lat0
  576.  
  577.         lon0 = lon0 + (q(0)-p(0)) + 360.
  578.  
  579.         while (lon0 GT 180) do lon0 = lon0 - 360.
  580.         while (lon0 LT -180) do lon0 = lon0 + 360.
  581.  
  582.         WIDGET_CONTROL, lat_slider, SET_VALUE=lat0
  583.         WIDGET_CONTROL, lon_slider, SET_VALUE=lon0
  584.         goto, draw_it
  585.     endif                       ;  of Drag.
  586.  
  587.     RETURN
  588.  
  589.     set_ll:
  590.     sText.text[6] = STRING(p(0), p(1), $
  591.                            FORMAT= "('Lon: ',f7.1, ', Lat: ', f6.1)")
  592.     putTips, sText, wText[1], ['locat'], [2]
  593.  
  594.     if (cir.llflag EQ 2) then begin ;Marked 2nd point for gt circle?
  595.         cir_2p, cir.ll, p(0:1)
  596.         cir.llflag = 0
  597.     endif
  598.  
  599.     if (cir.llflag EQ 1) then begin ;Marked 1st pnt for gt circle?
  600.         sText.text[7] = 'Mark second point.'
  601.         putTips, sText, wText[1], ['void','time1'], [0,1]
  602.         cir.ll = p(0:1)
  603.         cir.llflag = 2
  604.     endif
  605.  
  606.     RETURN
  607.  
  608. endif                           ;Cursor hit on map
  609.  
  610. if (STRMID(eventval, 0, 1) EQ '|') then begin ;  If '|' in value, its a menu
  611.     ev = STRMID(eventval, 1, 100) ; get event name by stripping off the '|'
  612.  
  613.     if (ev EQ 'File|Quit') then begin
  614.         WIDGET_CONTROL, event.top, /DESTROY
  615.         RETURN
  616.     endif else if (ev EQ 'Edit|Reset') then begin ;Reset to initial values
  617.         lat0 = 0.
  618.         lon0 = 0.
  619.         rot0 = 0.
  620.         WIDGET_CONTROL, LAT_SLIDER, SET_VALUE=lat0
  621.         WIDGET_CONTROL, LON_SLIDER, SET_VALUE=lon0
  622.         WIDGET_CONTROL, ROT_SLIDER, SET_VALUE=rot0
  623.     endif else if (ev EQ 'About|About Maps') then begin
  624.         if (Xregistered('XDisplayfile') NE 0) then RETURN
  625.         XDisplayfile, filepath("map_demo.txt", $
  626.                                SUBDIR=['examples','demo','demotext']), $
  627.           DONE_BUTTON='Done', $
  628.           TITLE="About the Map Demo", $
  629.           GROUP=event.top, $
  630.           WIDTH=68, HEIGHT=18
  631.         RETURN
  632.         
  633.     endif else if (STRPOS(ev, 'Continents') GT 0) then begin
  634.                                 ;  Toggle the continents/elevation choices..
  635.         i = map_menu_choice(eventval, MenuItems, MenuButtons)
  636.         do_cont = 0
  637.         do_elev = 0
  638.         if (i le 2) then do_cont = i else do_elev = i-2    
  639.     endif else if (STRPOS(ev, 'Interpolation') GT 0) then begin
  640.                                 ;  image and object interpolation choices
  641.         interpolation = map_menu_choice(eventval, MenuItems, MenuButtons)
  642.         if (do_elev EQ 0) then RETURN ;  don't redraw unless elevations are on.
  643.     endif else if STRPOS(ev, 'Rivers') GT 0 then begin
  644.         do_rivers = MenuToggleState(event.id) ;New river state
  645.     endif else if STRPOS(ev, 'Isotropy') GT 0 then begin ;New isotropic setting
  646.         iso = MenuToggleState(event.id)
  647.     endif else if STRPOS(ev, 'Boundaries') GT 0 then begin
  648.         do_political = MenuToggleState(event.id) ;New political setting
  649.     endif else if STRPOS(ev, 'View|Cities') EQ 0 then begin
  650.         all_cities = MenuToggleState(event.id) ;New city setting
  651.     endif else if (ev EQ 'Cities|Find') then begin
  652.         if (WIDGET_INFO(city_base, /VALID) EQ 0) then begin
  653.                                 ;  Create the city finder widget.
  654.             city_base = WIDGET_BASE(Title='Cities', /COLUMN, $
  655.                                     EVENT_PRO='d_map_event', $
  656.                                     GROUP_LEADER=event.top)
  657.  
  658.             wCityList = WIDGET_LIST(city_base, VALUE=city_pos.names, $
  659.                                     YSIZE = 12, UVALUE="CITY_SELECT")
  660.  
  661.             wDismissButton = WIDGET_BUTTON(city_base, $
  662.                                            VALUE='Dismiss', /NO_REL, $
  663.                                            UVALUE='CITY_DISMISS')
  664.  
  665.             WIDGET_CONTROL, city_base, /REALIZE
  666.             XMANAGER, "map_cities", city_base, $
  667.               EVENT_HANDLER="d_map_event",$
  668.               GROUP_LEADER = event.top
  669.         endif $
  670.         else WIDGET_CONTROL, city_base, /MAP ;Already mapped, just show it
  671.         RETURN
  672.  
  673.     endif else if (ev EQ 'Cities|Mark All') then begin ;Mark all cities
  674.         if ((do_cont GE 2) or (do_elev NE 0)) then begin
  675.             CCOLOR = 0 
  676.         endif else begin
  677.             CCOLOR = 1
  678.         endelse
  679.  
  680.         for i = 0, N_ELEMENTS(city_pos.names)-1 do begin
  681.             p = city_mark(i, COLOR=ccolor)
  682.         endfor
  683.         return
  684.  
  685.     endif else if (ev EQ 'Great Circles|Draw') then begin ;Draw great circle
  686.         cir.color = cir.color+1
  687.         if (cir.color GE 16) then cir.color = 4
  688.         drawcirc, cir.rot, cir.lon0, cir.color
  689.         RETURN
  690.  
  691.     endif else if (ev EQ 'Great Circles|Connect Two Points') then begin
  692.         cir.llflag = 1          ;Expecting first point
  693.         sText.text[7] = 'Mark first point.'
  694.         
  695.         putTips, sText, wText[1], ['void','time1'], [0,1]
  696.         RETURN
  697.  
  698.     endif else print,'Unknown Menu Item: ', ev
  699.  
  700. endif else case eventval of     ;Must be a slider event
  701.     "LAT_SLIDER":    lat0 = event.value
  702.     "LON_SLIDER":    lon0 = event.value
  703.     "ROT_SLIDER":    rot0 = event.value
  704.     "SALT"      :    sat_params(0) = 1.0 + event.value / 6371.; Sat altitude
  705.     "SALPHA"    :   sat_params(1) = event.value
  706.     "SBETA"        :   sat_params(2) = event.value
  707.     "CITY_DISMISS": begin
  708.         WIDGET_CONTROL, city_base, MAP=0
  709.         RETURN
  710.     endcase
  711.  
  712.     "CITY_SELECT": begin        ;  Draw the selected city.
  713.         p = city_mark(event.index) ;The item selected
  714.         if (FINITE(p(0))) then goto, set_ll
  715.         goto, off_map
  716.     endcase
  717.     
  718.     "SCALE": begin              ;New map scale
  719.         WIDGET_CONTROL, event.id, GET_VALUE=v
  720.         scale = FLOAT(v(0))
  721.         minmax = [1,400]
  722.         if (scale NE 0) and $
  723.           (scale LT minmax(0) or scale GT minmax(1)) then begin
  724.             scale = scale > minmax(0) < minmax(1)
  725.             WIDGET_CONTROL, event.id, SET_VALUE=STRTRIM(scale,2)
  726.         endif
  727.         scale = scale * 1.0e6   ;To millions
  728.     endcase
  729.  
  730.     "PROJ": begin               ;New projection
  731.         iproj = event.index+1   ;New projection number
  732.         if (last_p EQ iproj) then RETURN ; Nothing to do?
  733.         last_p = iproj
  734.  
  735.         if (projs(iproj) EQ "Satellite") then begin
  736.                                 ;  Case of a satellite projection, open
  737.                                 ;  an new window that let select its parameters.
  738.             slide_wid = 250
  739.             sat_base = LONARR(5)
  740.             sat_base(0) = $
  741.               WIDGET_BASE(title='Satellite Projection Parameters', /COLUMN)
  742.  
  743.             sat_base(1) = $
  744.               WIDGET_SLIDER(sat_base(0), XSIZE=slide_wid, $
  745.                             MINIMUM=100, MAXIMUM=15000, $
  746.                             VALUE=(sat_params(0)-1) * 6371., $
  747.                             TITLE='Altitude (Km)', $
  748.                             UVALUE="SALT")
  749.  
  750.             sat_base(2) = $
  751.               WIDGET_SLIDER(sat_base(0), XSIZE=slide_wid, $
  752.                             MINIMUM=-89, MAXIMUM=89, $
  753.                             VALUE=sat_params(1), TITLE='Alpha (up)',$
  754.                             UVALUE="SALPHA")
  755.  
  756.             sat_base(3) = $
  757.               WIDGET_SLIDER(sat_base(0), XSIZE=slide_wid, $
  758.                             MINIMUM=-180, MAXIMUM=180, $
  759.                             VALUE=sat_params(2), $
  760.                             TITLE='Beta (rotation)', $
  761.                             UVALUE="SBETA")
  762.  
  763.             WIDGET_CONTROL, sat_base(0), /REALIZE
  764.  
  765.             XMANAGER, "map_demo_satellite", sat_base(0), $
  766.               EVENT_HANDLER="D_MAP_EVENT", $
  767.               GROUP_LEADER=event.top
  768.             RETURN
  769.  
  770.         endif else begin        ;Not a satellite projection
  771.             if (sat_base(0) NE 0) then begin ;  Kill satellite base if active.
  772.                 if (WIDGET_INFO(sat_base(0),/valid)) then $
  773.                   WIDGET_CONTROL, sat_base(0),/DESTROY
  774.                 sat_base(0) = 0
  775.             endif
  776.         endelse                 ;Not satellite
  777.     endcase                     ; of Projection
  778.  
  779.     else: MESSAGE, "Event user value not found " + eventval
  780.  
  781. endcase
  782.  
  783. draw_it:  WIDGET_CONTROL, event.top, /HOURGLASS
  784. map_demo_draw                   ;**********    Draw the map....
  785. end
  786.  
  787. ;-----------------------------------------------------------------
  788. ;
  789. ;    PURPOSE : cleanup procedure. restore colortable, destroy objects.
  790. ;
  791. pro d_map_Cleanup, $
  792.        wTopBase                 ; IN: Top level base identifier
  793.  
  794. COMMON map_demo_com
  795.  
  796. TVLCT, SavedColors              ; Restore the color table.
  797. if (WIDGET_INFO(groupBase, /VALID_ID)) then $
  798.   WIDGET_CONTROL, groupBase, /MAP
  799. end                             ;  of d_map_Cleanup
  800.  
  801. ;----------------------------------------------------------------------------
  802. ;
  803. ;  PURPOSE Main map procedure.
  804. ;
  805. pro d_map, $
  806.        Image, $                 ; IN: (opt) image warped around the
  807.                                 ; projection that should be properly
  808.                                 ; scaled.
  809.        GROUP=GROUP, $           ; IN: (opt) Group leader identifier
  810.        Xsize = Xsize, $         ; IN: (opt) X size of the viewing area.
  811.        APPTLB=appTlb            ; OUT: (opt) main procedure top level base ID
  812.  
  813. COMMON map_demo_com
  814.  
  815.                                 ;  Make sure that only one instance is active.
  816. if (XRegistered("d_map")) then RETURN
  817.  
  818.  
  819. if N_ELEMENTS(group) then groupbase = group else groupbase = 0L
  820.  
  821. TVLCT, SavedColors, G, B, /GET ;  save the current color table
  822. SavedColors = [[SavedColors],[G],[B]] ;  save in a (n,3) array
  823.  
  824. DEVICE, GET_SCREEN_SIZE = scrSize
  825. drawbase = startmes('Mapping Demo', GROUP=groupbase)
  826.  
  827. if (N_ELEMENTS(image) GT 1) then begin ;image to warp over data provided?
  828.     elev_data = image > 16b     ; Bottom 16 colors are used for grids
  829. endif
  830.  
  831. iproj = 2                       ; orthographic
  832. last_p = -1
  833. if (N_ELEMENTS(xsize) EQ 0) then begin ;  Size the viewing area to screen 
  834.     xsize = FIX(0.56 * scrSize(0))
  835. endif
  836.  
  837. DEVICE, DECOMPOSED = 0          ;  Set to a 8 bits (256 colors) display.
  838. list_ht = ([6,9])(xsize GE 400) ;  List widget height for small screens.
  839.  
  840. ysize = xsize * 4 / 5           ;  Initialize working variables.
  841. sliderwidth = 200 < (xsize/3)
  842. lat0 = 0
  843. lon0 = 0
  844. rot0 = 0
  845. do_cont = 2                     ;Initial default = fill continents
  846. do_elev = 0
  847. do_rivers = 0
  848. do_political = 0
  849. iso = 1
  850. all_cities = 0
  851. scale = 0.0
  852. interpolation = 0
  853. city_base = 0L
  854. elevColor = 10                  ;First color used for elevations
  855. !p.multi=0
  856.  
  857. cir = { CIRCLE_PARAMS, $        ;Great circle object
  858.         base : 0L, lon0 : 0.0, rot : 0.0, color : 4, $
  859.         ll : [0., 0.], llflag : 0 }
  860.  
  861. sat_params = [ 1.2, 0, 0]       ;Salt, salpha, sbeta  = Initial satellite params
  862.  
  863. sat_base = LONARR(5)
  864. sText = getTips(filepath('map_demo.tip', $ ;  Get the tips.
  865.                          SUBDIR=['examples','demo', 'demotext']))
  866.  
  867.  
  868. map_demoBase = WIDGET_BASE(TITLE="Mapping", $ ;Main base, not mapped yet
  869.                            MAP=0, $
  870.                            /TLB_KILL_REQUEST_EVENTS, $
  871.                            TLB_FRAME_ATTR=1, $
  872.                            MBAR=bar_base, /COLUMN, GROUP=groupbase)
  873.  
  874. MenuItems = ['1File', '2Quit', $
  875.              '1Edit', '2Reset', $
  876.              '1View', $
  877.              '1Continents', '0None', '0Outlines', '4Fill', $
  878.                  '0Low Res Elevations', '0Medium Res', '2High Res', $
  879.              '1Interpolation', '4Image', '2Object', $
  880.              '0Rivers (Off)', $
  881.              '0Boundaries (Off)', $
  882.              '0Cities (Off)', $
  883.              '2Isotropy (On )', $
  884.              '1Cities', '0Mark All', '2Find', $
  885.              '1Great Circles', '0Connect Two Points', '2Draw', $
  886.              '1About', '2About Maps']
  887.  
  888. MenuCreate, MenuItems, MenuButtons, Bar_base ;  Create the menu bar.
  889.  
  890. if (N_ELEMENTS(projs) EQ 0) then begin ;  Define projection names.
  891.     resolve_routine, 'map_set'  ;  Cause we call map_proj_info first.
  892.     map_proj_info, PROJ_NAMES=projs
  893. endif
  894.  
  895.  
  896. wSubBase = WIDGET_BASE(map_demobase, /ROW) ;Create the column sub base.
  897. l_base = WIDGET_BASE(wSubBase, /COLUMN) ;  Create the left side widgets.
  898.  
  899.  
  900. wJunk = WIDGET_BASE(l_base, /COLUMN, /FRAME)
  901. wProjLabel = WIDGET_LABEL(wJunk, VALUE='Projection')
  902. p_list = WIDGET_LIST(wJunk, VALUE=projs(1:*), $ ;projection list
  903.                      YSIZE=list_ht, UVALUE='PROJ')
  904.  
  905. lon_slider = WIDGET_SLIDER(l_base, XSIZE = sliderwidth, $
  906.                            MINIMUM = -180, MAXIMUM = 180, VALUE=lon0, $
  907.                            TITLE = 'Center Longitude', uvalue = "LON_SLIDER")
  908. lat_slider = WIDGET_SLIDER(l_base, XSIZE = sliderwidth, $
  909.                            MINIMUM = -90, MAXIMUM = 90, VALUE=lat0, $
  910.                            TITLE = 'Center Latitude', uvalue = "LAT_SLIDER")
  911. rot_slider = WIDGET_SLIDER(l_base, XSIZE = sliderwidth, $
  912.                            MINIMUM = -90, MAXIMUM = 90, VALUE=rot0, $
  913.                            TITLE = 'Rotation', uvalue = "ROT_SLIDER")
  914. wJunk = WIDGET_BASE(l_base, /ROW)
  915. wScale1Label = WIDGET_LABEL(wJunk, VALUE="Scale ")
  916. scale_txt = WIDGET_TEXT(wJunk, XSIZE=10, YSIZE=1, $
  917.                         VALUE='0.0', $
  918.                         /EDITABLE, UVALUE="SCALE")
  919. wScale2Label = WIDGET_LABEL(wJunk, VALUE="Million : 1")
  920.  
  921. if (N_ELEMENTS(city_pos) LE 0) then begin ;Input City data base if 1st time
  922.     file = filepath('cities.dat', $
  923.                     SUBDIR=['examples','demo','demodata'])
  924.     OPENR, unit, file, /GET_LUN, ERROR=i
  925.     
  926.     if (i LT 0) then begin
  927.         a = DIALOG_MESSAGE(['City data file', file, 'not found'],/ERROR)
  928.         i = 4
  929.         city_names = STRARR(i)  ;Fake it
  930.         city_pos = FLTARR(2,i)
  931.     endif else begin
  932.         i = (fstat(unit)).size/12 ;Approx number of cities
  933.         city_names = STRARR(i)
  934.         city_pos = FLTARR(2,i)
  935.         i = 0
  936.         x=0. & y=0. & z = ''
  937.  
  938.         while (NOT Eof(unit)) do begin
  939.             READF,unit, x, y, z
  940.             city_names(i) = z
  941.             city_pos(0,i) = x    ;Latitude
  942.             city_pos(1,i) = y
  943.             i = i + 1
  944.         endwhile
  945.         CLOSE, unit
  946.         FREE_LUN, unit
  947.  
  948.         city_pos = city_pos(*,0:i-1) ;correct for file being in degrees.minutes
  949.         icity = FIX(city_pos)
  950.         fcity = city_pos - FIX(city_pos) ;Decimal fractions
  951.         city_pos = icity + (fcity * (100./60.)) ;  Convert minutes to 100ths.
  952.     endelse    
  953.  
  954.     city_pos = { CITY_POS, $
  955.                  names : STRTRIM(city_names(0:i-1),2), $
  956.                  pos : city_pos }
  957. endif
  958.  
  959. r_base = WIDGET_BASE(wSubBase, /COLUMN) ;  Create the right side widgets.
  960.                                 ;
  961. drawable = WIDGET_DRAW(r_base, XSIZE=xsize, YSIZE=ysize, $ ;  view area.
  962.                        RETAIN=2, /BUTTON_EVENTS, /MOTION_EVENTS)
  963.  
  964. wStatusBase = WIDGET_BASE(map_demobase, MAP=0, /ROW) ;  Create tips texts.
  965.  
  966. nWidgets = 2
  967. wText = LONARR(nWidgets)
  968. widTips, wStatusBase, sText.text, XSIZE=36, YSIZE=3, NWIDGETS=nWidgets, wText
  969.  
  970. WIDGET_CONTROL, map_demobase, /REALIZE, /HOURGLASS
  971.  
  972. appTlb = map_demobase           ;  Return top level base into APPTLB variable.
  973.  
  974. WIDGET_CONTROL, drawable, GET_VALUE=map_window ;  Get the window ID.
  975.  
  976. sizeTips, map_demobase, wText, wStatusBase
  977.  
  978. sText.text[7] = 'Move Mouse on map'
  979. sText.text[8] = 'for inverse transforms'
  980.  
  981. putTips, sText, wText[1], ['time1', 'time2'], [0,1]
  982.  
  983. WIDGET_CONTROL, p_list, SET_LIST_SELECT=1
  984.  
  985. WSET, map_window  
  986. map_demo_color, ElevColor       ;  Load our color tables.
  987. map_demo_draw                   ;  Draw the first map.
  988.  
  989. WIDGET_CONTROL, drawbase, /DESTROY ;  Destroy the startup window.
  990. WIDGET_CONTROL, map_demoBase, MAP=1 ;  Map the top level base.
  991. XMANAGER, "d_map", map_demobase, $ ;  Register with XMANAGER.
  992.   CLEANUP='d_map_cleanup', $
  993.   /NO_BLOCK
  994.  
  995. WIDGET_CONTROL, map_demobase, HOURGLASS=0
  996. elev_data = 0                   ;  Free up some memory.
  997. end                             ;   of main procedure d_map
  998.